home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / stv.lha / STV / st_v / util / STVUTIL5.ZIP / SCLPN.MTH < prev    next >
Text File  |  1993-02-07  |  9KB  |  290 lines
  1. "
  2. Implementation of a GraphPane which handles the scrollbars correct.
  3. (C) 1991, Roelof Osinga
  4.  
  5. Although this is copyrighted code you are free to use it as pleased. The
  6. only restriction is that the copyright notice is maintained.
  7. "
  8.  
  9. ! Rectangle methods !
  10. areaPoint: aPoint
  11.         "Answer true if aPoint is within the area of
  12.          the receiver, else answer false."
  13.     ^(aPoint x >= leftTop x) and: [(aPoint x <= rightBottom x)
  14.         and: [(aPoint y >= leftTop y) and: [aPoint y <=rightBottom y]]]! !
  15.  
  16. "define class"
  17.  
  18. FreeDrawPane subclass: #MyGraphPane
  19.   instanceVariableNames: 'eraseReturn'
  20.   classVariableNames: ''
  21.   poolDictionaries:
  22.     'CharacterConstants ColorConstants WinConstants DrawingModeConstants '!
  23.  
  24. ! MyGraphPane methods !
  25. backup: aBitmap
  26.         "Change the backup to a new bitmap"
  27.     | extent |
  28.     backup notNil ifTrue: [
  29.         extent := backup extent.
  30.         GDILibrary setViewportOrg: graphicsTool handle
  31.             x: 0
  32.             y: 0.
  33.             backup release].
  34.     backup := aBitmap.
  35.     topCorner := nil.
  36.     self updateRectangle; display! !
  37.  
  38. ! MyGraphPane methods !
  39. contents
  40.         "Answer the receiver's backup form."
  41.     ^backup! !
  42.  
  43. ! MyGraphPane methods !
  44. contents: aBitmap
  45.         "Change the backup to a new bitmap"
  46.     self backup: aBitmap! !
  47.  
  48. ! MyGraphPane methods !
  49. erase
  50.     "Erase the bitmap and pane"
  51.     backup notNil
  52.         ifTrue: [backup pen erase].
  53.     ^super erase! !
  54.  
  55. ! MyGraphPane methods !
  56. scrollingRectangle
  57.         "Private - Answer the rectangle or the
  58.          boundingBox of the image."
  59.     backup notNil
  60.         ifTrue: [^backup boundingBox]
  61.         ifFalse: [^rectangle expandBy: (rectangle extent // 2)]! !
  62.  
  63. ! MyGraphPane methods !
  64. scrollingRectangleRange
  65.         "Private - Answer the rectangle in which the
  66.          topCorner must lie."
  67.     | box |
  68.     ^(self scrollingRectangle insetBy: rectangle)
  69.                 merge: (0@0 extent: 0@0)! !
  70.  
  71. ! MyGraphPane methods !
  72. setScrollRanges
  73.         "Private - Set the ranges for the horizontal and vertical
  74.           scroll bars."
  75.     | rangeRect minHorz maxHorz minVert maxVert |
  76.     rangeRect := self scrollingRectangleRange.
  77.     minHorz := rangeRect left.
  78.     maxHorz := rangeRect right.
  79.     minVert := rangeRect top.
  80.     maxVert := rangeRect bottom.
  81.     (self style bitAnd: WsHscroll) = 0
  82.         ifTrue: [minHorz := maxHorz := 0].
  83.     (self style bitAnd: WsVscroll) = 0
  84.         ifTrue: [minVert := maxVert := 0].
  85.     UserLibrary
  86.         setScrollRange: self asParameter
  87.         bar: SbHorz
  88.         min: minHorz
  89.         max: maxHorz
  90.         redraw: false.
  91.     UserLibrary
  92.         setScrollRange: self asParameter
  93.         bar: SbVert
  94.         min: minVert
  95.         max: maxVert
  96.         redraw: false! !
  97.  
  98. ! MyGraphPane methods !
  99. updateRectangle
  100.         "Private - Update rectangle to be the same
  101.          as the Windows."
  102.     rectangle := self rectangle.
  103.     backup isNil
  104.         ifTrue: [
  105.             graphicsTool notNil ifTrue: [
  106.                 graphicsTool
  107.                     width: rectangle width;
  108.                     height: rectangle height]]
  109.         ifFalse: [graphicsTool notNil ifTrue: [
  110.             graphicsTool
  111.                 width: backup width;
  112.                 height: backup height]].
  113.     children size ~= 0
  114.         ifTrue: [
  115.             children do: [:each |
  116.                 each updateRectangle]].
  117.     self setScrollRanges.
  118.     topCorner isNil ifTrue: [topCorner := "1@1 "0@0].
  119.     self updateSliders.
  120.     self event: #resize! !
  121.  
  122. !MyGraphPane methods !
  123. wmErasebkgnd: wordInteger with: longInteger
  124.         "Private - Process the Win erase background message."
  125.     (eraseReturn = nil)
  126.         ifTrue: [^nil]
  127.         ifFalse: [eraseReturn := nil. ^0]! !
  128.  
  129. !MyGraphPane methods !
  130. scrollTopCorner: aPoint
  131.         "Private - Move the contents of the receiver
  132.          pane by extent aPoint."
  133.     | oldCorner scrollRect delta |
  134.     delta := aPoint.
  135.     oldCorner := topCorner deepCopy.
  136.     topCorner := topCorner - delta.
  137.     oldCorner = topCorner ifTrue: [^self].
  138.     ((scrollRect := self scrollingRectangleRange) areaPoint: topCorner) ifFalse: [
  139.         (scrollRect left > topCorner x) ifTrue: [topCorner x: scrollRect left].
  140.         (scrollRect right < topCorner x) ifTrue: [topCorner x: scrollRect right].
  141.         (scrollRect top > topCorner y) ifTrue: [topCorner y: scrollRect top].
  142.         (scrollRect bottom < topCorner y) ifTrue: [topCorner y: scrollRect bottom].
  143.         topCorner = oldCorner ifTrue: [
  144.             topCorner := oldCorner deepCopy.
  145.             ^self].
  146.         delta := oldCorner - topCorner.
  147.         ].
  148.     UserLibrary scrollWindow: handle
  149.         xAmount: delta x
  150.         yAmount: delta y
  151.         lpRect: nil
  152.         clipRect: nil.
  153.     GDILibrary offsetViewportOrg: graphicsTool handle
  154.         x: delta x
  155.         y: delta y.
  156.     UserLibrary updateWindow: handle.
  157.     eraseReturn := 0!  !
  158.  
  159. "define class"
  160.  
  161. BitEditor subclass: #RoBitEditor
  162.   instanceVariableNames:
  163.     'pane '
  164.   classVariableNames: ''
  165.   poolDictionaries:
  166.     'WinConstants ColorConstants '!
  167.  
  168. ! RoBitEditor methods !
  169. openOn: aGraphPane
  170.         "Open a BitEditor on aGraphPane."
  171.    self openOn: aGraphPane
  172.         clipRect: (0 @ 0 extent: aGraphPane contents extent)! !
  173.  
  174. ! RoBitEditor methods !
  175. openOn: aGraphPane clipRect: aRect
  176.         "Open a BitEditor on aBitmap."
  177.     | groupPane size imageSize |
  178.     scale := 8.
  179.     pane := aGraphPane.
  180.     imageForm := aGraphPane contents.
  181.     imageSize := (aRect extent min: imageForm extent) min:
  182.         (Display width - 80 // scale @
  183.             (Display height - 20 // scale)).
  184.     imageRect := aRect origin extent:
  185.         (aRect extent min: imageSize).
  186.     imageSize := imageSize * scale + (5 @ 5).
  187.     size := 76 @ (300 max: imageSize y).
  188.     copy := Bitmap screenExtent: aRect extent.
  189.     copy pen copyBitmap: aGraphPane contents
  190.         from: aRect
  191.         at: 0 @ 0.
  192.     self label: 'BitEditor'.
  193.     self addSubpane: (
  194.         GraphPane new
  195.             model: self;
  196.             when: #display perform: #displayImage:;
  197.             style: GraphPane noScrollBarsFrameStyle;
  198.             framingBlock: [: box |
  199.                 box origin extent: (size x @ (box height // 2))]).
  200.     self addSubpane:
  201.         (groupPane := GroupPane new
  202.             framingBlock: [: box |
  203.                 box origin x @ (box origin y + (box height // 2))
  204.                     extent: (size x @ (box height // 2))]).
  205.     groupPane addSubpane:
  206.         (Button new
  207.             model: self;
  208.             contents: 'Save';
  209.             pushButton;
  210.             when: #clicked perform: #save:;
  211.             framingBlock: [: box |
  212.                 (box origin x + (box width // 6)) @ (box origin y + (box height // 6))
  213.                     extent: (box width * 2 // 3) @ (box height // 3)]).
  214.    groupPane addSubpane:
  215.         (Button new
  216.             model: self;
  217.             contents: 'Exit';
  218.             pushButton;
  219.             when: #clicked perform: #exit:;
  220.             framingBlock: [: box |
  221.                 (box origin x + (box width // 6)) @ (box origin y + (box height // 2))
  222.                     extent: (box width * 2 // 3) @ (box height  // 3)]).
  223.     self addSubpane:
  224.         (GraphPane new
  225.             owner: self;
  226.             when: #getMenu perform: #editMenu:;
  227.             when: #display perform: #displayBits:;
  228.             when: #button1Down perform: #changeBits:;
  229.             when: #button1Move perform: #changeBits:;
  230.             style: GraphPane noScrollBarsFrameStyle;
  231.             framingBlock: [: box |
  232.                 box origin x + (size x @ 0)  extent: (
  233.                     (box width - size x) @ box height)]).
  234.     windowSize := 76 + imageSize x + 2 @
  235.         (( 300 max: imageSize y) + SysFont height + 6).
  236.     self openWindow.
  237.     self menuWindow addMenu: (
  238.         Menu colorMenu: self selector: #colorSelected:)! !
  239.  
  240. ! RoBitEditor methods !
  241. save: aButtton
  242.     imageForm pen copyBitmap: copy
  243.         from: copy boundingBox
  244.         at: imageRect origin.
  245.     pane display! !
  246.  
  247.  
  248. "define class"
  249.  
  250. FreeDrawing subclass: #MyFreeDrawing
  251.   instanceVariableNames: ''
  252.   classVariableNames: ''
  253.   poolDictionaries:
  254.     'WinConstants ColorConstants '!
  255.  
  256. ! MyFreeDrawing methods !
  257. backupRelative: aPoint
  258.         "Private - Answer a point relative to the pane's backup
  259.          from aPoint."
  260.     ^aPoint! !
  261.  
  262. ! MyFreeDrawing methods !
  263. bitEdit
  264.         "Prompt the user for a rectangle and open a BitEditor
  265.          on the bitmap associated with the rectangle."
  266.     | aRect |
  267.     aRect := Display rectangleFromUser mapToWindow: pane.
  268.     aRect moveBy: pane topCorner - (1@1).
  269.     RoBitEditor new openOn: pane
  270.         clipRect: aRect! !
  271.  
  272. ! MyFreeDrawing methods !
  273. open
  274.         "Open a Free Drawing window."
  275.     self label: 'FreeDrawing';
  276.         when: #activate perform: #activate:;
  277.         addSubpane: (
  278.             pane := MyGraphPane new
  279.                 owner: self;
  280.                 when: #getMenu perform: #modeMenu:;
  281.                 when: #getContents perform: #initPen:;
  282.                 when: #button1Down perform: #mouseDown:;
  283.                 yourself).
  284.     self openWindow.
  285.     self menuWindow addMenu: self optionsMenu.
  286.     self menuWindow addMenu: (
  287.         Menu colorMenu: self selector: #colorSelected:)! !
  288.  
  289.  
  290.